home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG: Games / PC-SIG Games (PC-SIG).iso / 1133 / WORLDGEN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-08-29  |  32.6 KB  |  838 lines
  1. {$R-}    {Range checking off}
  2. {$B+}    {Boolean complete evaluation on}
  3. {$I+}    {I/O checking on}
  4. {$N-}    {No numeric coprocessor}
  5.  
  6. Program World_Generator_One; {version 1.2}
  7.  {This program produces solar systems for SF role playing games,  but  is
  8.  not directly based on the rules of any one game. It requires an IBM PC
  9.  or clone with CGA graphics board, RGB monitor, Dos 2.0 or later.
  10.  Written in Turbo Pascal version 3.1, re-compiled with additional features
  11.  under version 4.0
  12.  
  13.  Copyright <c> - By Marcus L. Rowland - 1987, 1988, 1989
  14.                  22, Westbourne Park Villas,
  15.                  London W2 5EA,
  16.                  ENGLAND
  17.  
  18. PLEASE READ DOCUMENTATION FOR CONDITIONS OF DISTRIBUTION ETC.}
  19.  
  20. Uses CRT, Printer, Dos, Graph, Turbo3, Graph3, WG1; {declares units, holds variables and procedures used throughout program}
  21.  
  22. {-------------------------------------------------------------------------}
  23. {     PROCEDURES USED IN FAST SOLAR SYSTEM MAPPING & GENERATION ETC.      }
  24. {-------------------------------------------------------------------------}
  25.  
  26. {$I WG2.INC} {load the stuff for solar system generation and disk I/O}
  27.  
  28. {-------------------------------------------------------------------------}
  29. {        PROCEDURES FOR GENERATION OF DETAILED PLANET AND STAR DATA       }
  30. {-------------------------------------------------------------------------}
  31. {$I WG5.INC} {load stuff used in print-out phase}
  32. {$I WG6.INC} {stuff for planet mapping, map printing, and planetarium}
  33.  
  34.  
  35.  
  36. {-------------------------------------------------------------------------}
  37. {                        MAIN MAPPING PROCEDURES                          }
  38. {-------------------------------------------------------------------------}
  39.  
  40. Procedure Asteroid_Belt_Mapper;
  41. {Draw an asteroid belt}
  42. Begin;
  43.   Belt_Width := Random(5) + 1;
  44.   Gravity := 0.01 * Random;
  45.   Pressure := 0;
  46.   For V:= 1 to 2 do Colonies[V] := Random(3)*Random(3);
  47.   If (Statistics_Status <> -1) or (Astral <> 0) then exit;
  48.   Draw_Belt(2);
  49.   For X := 0 to 219 do
  50.      Begin;
  51.      For Y := 0 to 100 do
  52.        Begin;
  53.        if GetDotColor(X,Y) = 2 then if Random(35 - Belt_Width) = 0 then begin;
  54.            Z := Random(4);
  55.            If Y < 51 then Z := 0;
  56.            Circle(x,y,Z+1,0);
  57.            Fillshape(X,Y,0,0);
  58.            Circle (X,Y,Z,3);
  59.            Fillshape(X,Y,Z,3);
  60.        End;
  61.     End;
  62.   End;
  63.   Frame(0);
  64.   Fillshape(0,0,2,3);
  65.   Fillshape(0,0,0,3);
  66.   Show_Colonies(3);
  67.   Frame(2);
  68.   Show_Belt_or_Ring_suns;
  69. End;
  70.  
  71. Procedure Dust_Cloud_Details;
  72. {assumes a toroidal dust cloud orbiting a star, rather than a smaller "lump"
  73. of dust. Assumes that dust blocks off heat from outer planets.}
  74.  Begin;
  75.    Belt_Width := Random(5) + 4;
  76.    Gravity := 0;
  77.    Pressure :=0;
  78.    If (Statistics_Status <> -1) or (Astral <> 0) then exit;
  79.    Draw_Belt(3);
  80.    Slartibartfast(0,3,2,220);
  81.    Slartibartfast(0,0,4,220);
  82.    Frame(2);
  83.    Show_Belt_or_Ring_Suns;
  84.  End;
  85.  
  86. Procedure Ring_World_Details(builders: Integer);
  87. {if builders = 1 then oxygen else poison type}
  88. Begin;
  89.   Belt_Width := 4 + Random(5);
  90.   RW_Width := (1000000.0 * Belt_Width) + (Sqr(Random(1000)+1));
  91.   If Builders = 1 then
  92.      Oxygen_Atmosphere_etc
  93.   else begin;
  94.      Gravity := 0.5 + Random;
  95.      Poison_Atmosphere;
  96.   end;
  97.   If (Statistics_Status <> -1) or (Astral <> 0) then exit;
  98.   Draw_Belt(3);
  99.   Fillshape(110,6,2,0);
  100.   Fillshape(10,0,2,2);
  101.   Fillshape(210,0,2,2);
  102.   If builders = 1 then
  103.      Slartibartfast(1,3,6,220)
  104.   else
  105.      Slartibartfast(2,3,6,220);
  106.   For N := 0 to 5 do
  107.     Begin;
  108.       draw (110+20*N,50,110+24*N,100,0);
  109.       draw (110-20*N,50,110-24*N,100,0);
  110.     End;
  111.   Fillshape(0,55,0,0); Fillshape(25,70,0,0); Fillshape(75,80,0,0);
  112.   Fillshape(114,80,0,0); Fillshape(166,85,0,0); Fillshape(200,70,0,0);
  113.   If builders = 1 then begin;
  114.      GraphWindow (100,84,319,133);
  115.      Fillshape(100,0,2,1);
  116.      Fillshape(100,0,0,1);
  117.   end;
  118.   If Builders = 1 then Show_Colonies(builders) else Show_Colonies(3);
  119.   GraphWindow (100,34,319,133);
  120.   Circle (110,-175,272+Belt_Width,2);
  121.   Circle (110,-175,254,2);
  122.   IA := 10 + Belt_Width Div 2;
  123.   For N := 0 to 37 do
  124.   Begin;
  125.       X := Round (110-105*Sin(n/6));
  126.       Y := Round (45+25*Cos(n/6));
  127.       If Y<45 then V := 2 else V := 3;
  128.       If Odd (N) then For I := 0 to IA do begin;
  129.         If I = IA then V := 0;
  130.         draw (X,Y+I,Old_X,Old_Y+I,v);
  131.       end;
  132.       Old_X := X;
  133.       Old_Y := Y;
  134.     End;
  135.   Belt_Width := 2;
  136.   Frame(3);
  137.   Show_Belt_or_Ring_suns;
  138. End;
  139.  
  140. Procedure World_Mapper(World_Type: Integer);
  141. {Draw a simple map of an earthlike (1) or uninhabitable (2) world}
  142. Begin;
  143. If World_Type = 2 then begin;
  144.    Gravity := 0.5 + Random;
  145.    For V := 1 to 3 do if random(10)< 2 then Moon_Size[V] := Random(2);
  146.    Poison_Atmosphere;
  147. end else begin;
  148.    Oxygen_Atmosphere_etc;
  149.    If Random (5) <3 then Moon_Size[3] := Random(3) + 3
  150.         else Moon_Size[2] := Random(3) + 2;
  151.    If Random(10)<2 then Moon_Size[1] := Random(2);
  152. end;
  153. Planet_Mass := Sqr(Gravity);
  154. For V := 1 to 3 do
  155.    Begin;
  156.     if Moon_Size[V] > -1 then begin;
  157.       If Native_Technology > 10 then if Random(3) = 0 then Moon_Colonies[V,3] := 1;
  158.       For N:= 1 to 2 do If Random(10) = 0 then Moon_Colonies[V,N] := 1;
  159.    End;
  160. End;
  161. If (Statistics_Status <> -1) or (Astral <> 0) then exit;
  162. {Draw crude shapes; messy but fast}
  163. If World_Type = 1 then if Gravity < 1.0 then if Temperature > 310.0 then fillshape(1,1,3,2);
  164. If World_Type = 1 then Graphbackground(Blue);
  165. Ratio := Random(20)+10;
  166.     For y:= 1 to 19 do
  167.        Begin;
  168.        YY := Y*5;
  169.          For X := 1 to 43 do
  170.            begin;
  171.             XX := X*5;
  172.             Continent := getdotcolor(XX,YY);
  173.                If Random(Ratio) < 1 then if Continent = 3
  174.                  then continent := 0  else continent := 3;
  175.                If X = 43 then continent := getdotcolor(5,YY);
  176.              V := Random(6)+Random(6);
  177.              Circle(XX,YY,V,1);
  178.              Fillshape(XX,YY,1,1);
  179.              Circle(XX,YY,V,continent);
  180.              Fillshape(XX,YY,Continent,continent);
  181.            End;
  182.        End;
  183. {now fill in the fine detail}
  184. If World_Type = 2 then Mountains(0,2,Random(5)+5) else Mountains(3,2,Random(5)+5);
  185. Slartibartfast(World_Type,3,3,220);
  186. If World_Type = 2 then
  187.    Begin;
  188.      Frame(0);
  189.      Fillshape(0,0,3,2);
  190.    end;
  191. Save_Map;
  192. Show_Colonies(World_Type);
  193. If World_Type = 1 then World_Frame(2) else begin;
  194.      World_Frame(0);
  195.      Frame(1);
  196.     End;
  197. Show_Tilt;
  198. End;
  199.  
  200. Procedure Airless_World_Mapper;
  201. {Draw an airless world; type 3 with craters,
  202. type 4 with mountains, type 5 icy}
  203. Begin;
  204.   Native_Life := 10-Random(1000); {not likely!!}
  205.   If Native_Life >6 then Native_Technology := Random(Native_Life-4) + Random(10);
  206.   Colonies[3] := (Native_Technology);
  207.   Determine_Colonies(4);
  208.   If Temperature > 100 then if temperature < 1000 then
  209.   For V := 1 to 3 do
  210.    Begin;
  211.     if random(10)< 2 then Moon_Size[V] := Random(2);
  212.     If Moon_Size[V] >-1 then begin;
  213.       If Native_Technology > 10 then if Random(3) = 0 then Moon_Colonies[V,3] := 1;
  214.       For N:= 1 to 2 do If Random(20) = 0 then Moon_Colonies[V,N] := 1;
  215.     End;
  216.    End;
  217.   Tilt := Random(20);
  218.   Gravity := (Random + 0.1) / 2;
  219.   Planet_Mass := Sqr(Gravity);
  220.   If Temperature <300 then begin; {small hot worlds lose atmosphere}
  221.     Atmosphere[3] := 80+Random(10);
  222.     Atmosphere[5] := Random(100-Atmosphere[3]) + 1;
  223.     Atmosphere[6] := 100-(Atmosphere[3]+Atmosphere[6]);
  224.     Pressure := Sqr (gravity/5);
  225.   End;
  226.   If (Statistics_Status <> -1) or (Astral <>0) then exit;
  227.   If Planet_Code = '3' then fillscreen(3) else fillscreen(2);
  228.  
  229.   {chuck in meteors for all types}
  230.   For N := 1 to 200 do
  231.     begin;
  232.       Set_Random_XY;
  233.       V := Random(4);
  234.       If N<40 then V := Sqr(V);
  235.       Craters(X,Y,V);
  236.    End;
  237.  
  238.   {Mountains for type 4&5}
  239.   If Planet_Code >= '4' then begin;
  240.     Fillshape(0,0,2,3);
  241.     Mountains(2,2,Random(10)+20);
  242.     Frame(1);
  243.     Fillshape(0,0,3,0);
  244.   end;
  245.  
  246.   {icy bit for type 5}
  247.   If Planet_Code = '5' then Icecaps;
  248.  
  249.   {final details}
  250.   Save_map;
  251.   Show_Colonies(0);
  252.   World_Frame(2);
  253.   Frame(1);
  254.   Show_Tilt;
  255. End;
  256.  
  257. Procedure Gas_Giant_Mapper(World_Type: Integer);
  258. Begin;
  259.     Tilt := Random(10)+ Random(10);
  260.     If Random(100) = 0 then tilt := Tilt * 10;
  261.     Atmosphere[0] := Random(50) + 40;
  262.     Atmosphere[1] := 100 - Atmosphere [0];
  263.     Gravity := 1.0 + (Random * 4.0);
  264.     Planet_Mass := 150 * Gravity; {very rough!!!}
  265.     Pressure := Sqr (Sqr (Gravity)); {a guess}
  266.     Ring_Number := Random (10) + 2;
  267.     Temperature := Temperature + 10 * Gravity; {possible core heating}
  268.     If Random(2000) = 0 then native_life := Random(10); {not likely!!}
  269.     If Native_Life >6 then Native_Technology := Random(Native_Life) + Random(10);
  270.     Colonies[3] := Native_Technology;
  271.     For V := World_Type to (World_Type * 2) do begin;
  272.        If Random(10) > 3 then Moon_Size[V] := Random(3)+1;
  273.        If Moon_Size[V] >-1 then begin;
  274.          If Native_Technology > 12 then if Random(20) = 0 then Moon_Colonies[V,3] := 1;
  275.          For N:= 1 to 2 do If Random(20) = 0 then Moon_Colonies[V,N] := 1;
  276.        End;
  277.     End;
  278.   If (Statistics_Status <> -1) or (Astral <> 0) then exit;
  279.   If World_Type > 7 then begin;
  280.      Graphwindow(100,34,199,133);
  281.      For V := 1 to Ring_Number do Circle(0-(3*v),450-V,413,Random(3)+1);
  282.      For V := 0 to 45 do Circle (0,50,V,0);
  283.   End;
  284.   Circle(0,50,45,1);
  285.   Fillshape(0,50,1,1);
  286.   Circle(0,50,45,2);
  287.   Fillshape(0,50,0,2);
  288.   For Y := 6 to 94 do
  289.   Begin;
  290.     X := 0;
  291.     Band := Random(4);
  292.     Repeat
  293.        Plot(X,Y,Band);
  294.        If Random(3) = 0 then Circle(X,Y-1,Random(2),Band);
  295.        X := X + 1
  296.     Until GetDotColor(X,Y) = 2;
  297.   End;
  298.   Circle(0,50,46,0);
  299.   Graphwindow(100,34,130,133);
  300.   Show_Colonies(2);
  301.   Graphwindow(100,34,199,133);
  302.   If World_Type >7 then
  303.     for V := -2 to Ring_Number do circle(0-(V*3),V-350,412,Random(3)+1);
  304.   Graphwindow (100,34,319,165);
  305.    For V := World_Type to (World_Type * 2) do
  306.     If Moon_Size[V] > -1 then begin;
  307.         circle((10 * V)+30,50,Moon_Size[v],3);
  308.         For N:= 1 to 3 do begin;
  309.         If Moon_Colonies[V,N] >0 then Colony_Marker ((V*10)+30,55+(4*N),N);
  310.         End;
  311.     End;
  312.   Frame(2);
  313.   Show_Tilt;
  314. End;
  315.  
  316. Procedure Star_Details;
  317.    Begin;
  318.      If Planet_Number = 0 then Tilt := 0 else tilt := Random (5);
  319.      Star_Type := Copy(WG_System,(Planet_Number*2) + 4,2);
  320.      Get_Luminosity_Etc;
  321.      Gravity := (Exact_mass * 29)/Sqr (Exact_Radius);
  322.      If Planet_Number = 0 then Primary_Luminosity := Luminosity
  323.         else Primary_Luminosity :=
  324.            Primary_Luminosity + Luminosity / Planet_Number;
  325.      If Planet_Number = 0 then Primary_Mass := Exact_Mass;
  326.      Atmosphere[0] := 90 - Star_Radius; {probably crap}
  327.      Atmosphere[1] := 100 - Atmosphere [0];
  328.      If (Statistics_Status <> -1) or (Astral <> 0) then exit;
  329.      Grid_Scale;
  330.      Star_Display_Radius := Round (Exact_Radius * Magnification);
  331.      Circle(10,50,Star_Display_Radius,3);
  332.      Fillshape(10,50,3,3);
  333.      circle (10,50,(Star_Display_Radius * Atmosphere[0]) div 100,2);
  334.      Fillshape(10,50,2,2);
  335.      If Star_Type <> 'DG' then Slartibartfast(5,1,Random(3)+2,Star_Display_Radius+15);  {extend yellow & red bits}
  336.      Frame(1);
  337.      Show_Tilt;
  338.    End;
  339.  
  340. Procedure Binary_Star_Details;
  341. {This procedure generates a simple map of a close binary star pair.
  342. it assumes that, for each star, the mass of one star * it's distance from
  343. the common centre of gravity will equal that of the opposite star. It also
  344. surrounds both stars in a gas cloud. Both these assumptions are questionable.}
  345.    Begin;
  346.      Primary_Mass := 0;
  347.      D := Copy(WG_System,(Planet_Number*2) + 5,1);
  348.      Star_Selection := Ord (D[1]);
  349.      For V:= 0 to 1 do begin;
  350.        Get_Star_Type;
  351.        Get_Luminosity_etc;
  352.        Binary_Star_Luminosity[v] := Luminosity;
  353.        Binary_Star_Temperature[v] := Temperature;
  354.        Binary_Star_Mass[v] := Exact_Mass;
  355.        Binary_Star_Radius[v] := Exact_Radius;
  356.        Binary_Star_Type[v] := Star_type;
  357.        Binary_Star_Atmosphere[V,0] := Random(10)+80;
  358.        Binary_Star_Atmosphere[V,1] := 100 - Binary_Star_Atmosphere[V,0];
  359.        Binary_Star_Distance[V] := Round(10 / Binary_Star_Mass[v]);
  360.        Binary_Star_G[V] := (Exact_mass * 29.0)/Sqr (Exact_Radius);
  361.        Primary_Mass := Primary_Mass + Binary_Star_Mass[v];
  362.        Primary_Luminosity := Primary_Luminosity + Binary_Star_Luminosity[v];
  363.        If V= 0 then Star_Selection := 100-Star_Selection;
  364.      End;
  365.      If (Statistics_Status <> -1) or (Astral <>0) then exit;
  366.      Exact_Radius := Binary_Star_Radius[0]; {0 is bigger than 1}
  367.      Grid_Scale;
  368.      For V:= 0 to 1 do begin;
  369.         Binary_Star_Size[V] := Round(Binary_Star_Radius[V] * Magnification);
  370.         if V = 0 then Y := 110 - Binary_Star_Distance[V]
  371.           else Y := 110 + Binary_Star_Distance[V];
  372.         For X := 0 to Binary_Star_Size[V] do
  373.             Circle (Y,50, X, 3);
  374.         For X := 0 to (Binary_Star_Size[V] * Binary_Star_Atmosphere[V,0]) div 100 do Circle(Y,50,X,2);
  375.         If v = 0 then Slartibartfast(5,1,Random(2)+2,220);  {any colour above 1}
  376.      End;
  377.      Circle(y,50,Binary_Star_Size[1]+1,0);
  378.      Frame(1);
  379.      Square_grid;
  380.      for x := 0 to Binary_Star_Distance[1]+ Random(20) do circle(50,50,X,2); {Gas cloud around pair}
  381.      For V := 0 to 1 do begin;
  382.        if V= 0 then Y := 50 - (Binary_Star_Distance[V])
  383.          else Y := 50 + (Binary_Star_Distance[V]);
  384.        Circle(Y,Y,Round (Binary_Star_Radius[V])+2,3);
  385.        Fillshape(Y,Y,0,3);
  386.        Fillshape(Y,Y,2,3);
  387.      End;
  388.    End;
  389.  
  390. Procedure Black_Hole_Details;
  391. {show a black hole}
  392.    Begin;
  393.      Luminosity := 0.0001;
  394.      Exact_Mass := (Random (10) * 100) + Random(100) + Random;
  395.      Primary_Mass := Exact_Mass;
  396.      Exact_Radius := 0.0000005 * Exact_Mass;
  397.      Gravity := (Exact_mass * 29)/Sqr (Exact_Radius);
  398.      Ring_Number := Random (10) + 2;
  399.      If (Statistics_Status <> -1) or (Astral <> 0) then exit;
  400.      Grid_Scale;
  401.      ClearScreen;
  402.      GraphWindow (210,34,319,133);
  403.      Star_Display_Radius := Round (Exact_Radius * Magnification * 50);
  404.      For V := Star_Display_Radius Div 2 to Star_Display_Radius do Circle(0-(3*v),450-V,400,2);
  405.      GraphWindow (100,34,210,133);
  406.      For V := Star_Display_Radius Div 2 to Star_Display_Radius do Circle(100+(3*v),V-350,400,2);
  407.      GraphWindow (100,34,319,133);
  408.      For V:= 0 to Star_Display_Radius+2 do Circle(110,50,V,3);
  409.      Craters(110,50,Star_Display_Radius+2);
  410.      Circle(110,50,Star_Display_Radius+3,2);
  411.      Fillshape(110,50,0,2);
  412.      Slartibartfast(2,2,2,220);
  413.      Frame(1);
  414.      Square_Grid;
  415.      Graphwindow(10,44,89,123);
  416.      Slartibartfast(3,3,4,80); {gravitational distortion!}
  417.      Graphwindow(20,54,79,113);
  418.      Slartibartfast(3,3,3,60);
  419.      Circle(30,30,2,0);
  420.      Fillshape(30,30,0,0);
  421.      Plot(30,30,2);
  422.    End;
  423.  
  424. Procedure Protostar_Details;
  425. Begin;
  426.   Temperature := 5000.0 + (Random * Dust_Density * 100.0); {a wild guess}
  427.   Primary_Temperature := Temperature / 2; {some lost in cloud}
  428.   Exact_Mass := Random(5) + Random;
  429.   Primary_Mass := Exact_Mass;
  430.   Gravity := 15.0 + (Random * 10); {another guess}
  431.   Atmosphere[0] := Random(10)+90; {mostly hydrogen with a leetle He}
  432.   Atmosphere[1] := 100 - Atmosphere [0];
  433.   Tilt := 0;
  434.   Dust_Density := 50 + Random(100);
  435.   If (Statistics_Status <> -1) or (Astral <>0) then exit;
  436.   Pattern(Grid);
  437.   Ring_Number := Dust_Density Div 10;
  438.   FillPattern(2,1,218,98,1);
  439.   GraphWindow (210,34,319,133);
  440.   For V := 1 to Ring_Number do Circle(0-(3*v),450-V,413-Ring_Number,2);
  441.   GraphWindow (100,34,319,133);
  442.   For V:= 0 to Dust_Density Div 4 do Circle(110,50,V,0);
  443.   Craters(110,50,Dust_Density Div 4);
  444.   Circle(110,50,Dust_Density Div 4,2);
  445.   Fillshape(110,50,2,2);
  446.   Craters(110,50,Dust_Density Div 5);
  447.   Circle(110,50,Dust_Density Div 5+1,0);
  448.   GraphWindow (100,34,210 + (Dust_Density Div 7),133);
  449.   For V := 1 to Ring_Number do Circle(100+(3*v),V-350,413-Ring_Number,2);
  450.   GraphWindow (100,34,319,133);
  451.   For N := 0 to Dust_Density Div 2 do
  452.     Begin;
  453.       Repeat;
  454.         Set_Random_XY;
  455.       Until GetDotColor(X,Y) = 2;
  456.       V := Random(3);
  457.       If y>35 then if y<65 then if X>50 then if X<170 then
  458.            V := Sqr(V);
  459.       Craters(X,Y,V);
  460.       Circle(X,Y,V+1,0);
  461.   End;
  462.   Slartibartfast(5,1,3,220);  {any colour above 1}
  463.   Frame(1);
  464.   Square_Grid;
  465.   Circle (50,50,Dust_Density Div 4, 2);
  466.   Fillshape(51,51,2,2);
  467.   Circle (50,50,Dust_Density Div 6,3);
  468.   Fillshape(51,51,3,3);
  469.   For N := 1 to dust_density do
  470.     begin;
  471.     Repeat;
  472.       X := Random(100);
  473.       Y := Random(100);
  474.     Until GetDotColor(X,Y) = 2;
  475.     Craters(X,Y,Random(3));
  476.   End;
  477. End;
  478.  
  479. {-------------------------------------------------------------------------}
  480. {                    MAIN PLANET GENERATION PROCEDURE                     }
  481. {-------------------------------------------------------------------------}
  482.  
  483. Procedure Planet_Details(Bypass : Integer);
  484. {world generation}
  485. Begin;
  486.   If Bypass = 0 then Choose_System(1) else menu_status := 3;
  487.   If Menu_Status = 3 then
  488.       Begin;
  489.         WG_System := System_Details [Y_Coordinate, X_Coordinate];
  490.         If Security_Level > 1 then begin;
  491.            Security_Tag := Copy(WG_System,40,1);
  492.            If Security_tag = '*' then begin;
  493.               Writeln ('ACCESS DENIED!!'#10#13'DATA ON SYSTEM RESTRICTED!');
  494.               If Statistics_Status = -1 then Beep_Wait else Delay(1000);
  495.               exit;
  496.            end;
  497.         end;
  498.         If Statistics_Status <> 3 then Colour_Selection;
  499.         TextColor(2);
  500.         Body_Count := 0;
  501.         Primary_Mass := 0;
  502.         RandomSeed [0] := X_Coordinate + Y_Coordinate;
  503.         Old_Seed [0] := RandomSeed [0];
  504.         A := Copy(WG_System,3,1);
  505.         Val(A,V,n);
  506.         RandomSeed [1] := Sqr (V);
  507.         Old_Seed [1] := Randomseed [1];
  508.         System_Inclination := Random(360);
  509.         Primary_Luminosity := 0;
  510.         For Planet_Number := 0 to 17 Do
  511.           Begin;
  512.              Planet_Code := Copy(WG_System,(Planet_Number*2) + 4,1);
  513.              If Planet_Code <> ' ' then
  514.                 Begin;
  515.                 Graphbackground(Black);
  516.                 Old_Systems;
  517.                 If (Statistics_Status <> 3) AND (Astral = 0) then ClearScreen;
  518.                 Old_System_Map;
  519.                 If Planet_Number > 0 then Body_Count := Body_Count +1;
  520.                 Val(Planet_Code,World_Type,Z);
  521.                 X :=  Planet_Number * 17 + 5;
  522.                 Randomseed [0] := Old_Seed [0] + Ord(Planet_Code[1]) + Body_Count;
  523.                 Old_Seed [0] := Randomseed [0];
  524.                 RandomSeed [1] := Old_Seed [1] + X;
  525.                 Old_Seed [1] := Randomseed [1];
  526.                 Randseed := Randomseed[0] + Randomseed[1];
  527.                 If Planet_Number > 0 then begin;
  528.                   Orbital_Distance := Bode_Number [Planet_Number] * Primary_mass; {distance in AU}
  529.                   Temperature := 374.5 * (Exp(Ln(Luminosity)/4)) / Sqrt (Orbital_Distance);
  530.                   If temperature <=4.2 then temperature := 4.2;
  531.                   Mean_Eccentricity := 0.01 * (Random (10)+1);
  532.                   If Planet_Number >2 then if Planet_Number <15
  533.                     then Mean_Eccentricity := Mean_Eccentricity * 0.5;
  534.                   If Planet_Code = '0' then Mean_Eccentricity := Mean_Eccentricity * Random(20);
  535.                   Mean_Eccentricity := Mean_Eccentricity * Sqr(Stars_In_System);
  536.                   If Planet_Code >= 'A' then Mean_Eccentricity := 0.0;
  537.                   If Random(2) = 0 then Mean_Eccentricity := 0.0 - Mean_eccentricity;
  538.                   Orbital_Period :=
  539.                     Sqrt ((Sqr(Orbital_Distance)* Orbital_Distance)/Primary_Mass);
  540.                   Orbital_Period := Orbital_Period * 365.25; {convert to earth days}
  541.                   if Planet_Code >= 'Q' then if Planet_Code <='R' then Begin;
  542.                     Orbital_Distance := Orbital_Distance * 150 * 1.0E+9; {in metres!}
  543.                     Gravity := Gravity * 9.81; {conversion to metres/sec}
  544.                     Orbital_Velocity := Sqrt (Orbital_Distance * Gravity);
  545.                     Circumference := Orbital_Distance * Pi * 2.0;
  546.                     Orbital_Period := Circumference / Orbital_Velocity; {in seconds}
  547.                     Orbital_Period := Orbital_Period / 86400.0; {in days}
  548.                   End;
  549.                   Circle(X,15,5,2);
  550.                 end;
  551.                 If Statistics_Status = -1 then if Astral = 0 then begin;
  552.                   Graphwindow(100,134,319,199);
  553.                   ClearScreen;
  554.                   Graphwindow (0,34,99,133);
  555.                   ClearScreen;
  556.                   GraphWindow (100,34,319,133);
  557.                   Clearscreen;
  558.                 End else Graphwindow (0,33,319,199);
  559.                 Prepare_Atmosphere_etc;
  560.                 Case Char(Ord(Planet_Code[1])) of
  561.                    'Q': Ring_World_Details(2);
  562.                    'R': Ring_World_Details(1);
  563.                    'S': Dust_Cloud_Details;
  564.                    '*': Binary_Star_Details;
  565.                    '(': Black_Hole_Details;
  566.                    ')': Protostar_Details;
  567.                    '0': Asteroid_Belt_Mapper;
  568.               '1'..'2': Begin; Val(Planet_Code,V,I); World_Mapper(V); End;
  569.               '3'..'5': Airless_World_Mapper;
  570.               '6'..'9': Gas_Giant_Mapper(World_Type);
  571.               'A'..'M': Star_Details;
  572.                   end;
  573.                 If Planet_Code <> '*' then begin;
  574.                   If Gravity >1 then Str(Gravity:6:1,Pull) else Str(Gravity:5:4,Pull);
  575.                     Str(Temperature:6:0,Heat);
  576.                   If Planet_code = '(' then Str(Gravity:10:0,Pull);
  577.                   If Pressure >1 then Str(Pressure:5:2,Air_Force) else Str(Pressure:5:4,Air_Force);
  578.                 End;
  579.                 If (Statistics_Status = -1) and (Astral = 0) then begin;
  580.                   If Planet_Number = 0 then Orbit_Box
  581.                   else Orbital_Eccentricity;
  582.                   If Planet_Code = '*' then Binary_Star_Data
  583.                      else if Planet_Code = '(' then  Black_Hole_Data
  584.                        else Show_World_Data;
  585.                   Beep_Wait;
  586.                   If Demonstration = 2 then exit;
  587.                 end else if Astral <> 0 then begin;
  588.                   If Planet_Number = 0 then Big_Orbit_Box;
  589.                   If Planet_Number <> 0 then Plot_Planet_Position(Planet_Number);
  590.                 end else detailed_Print_out;
  591.                 if Dummy = 'D' then detailed_Print_out;
  592.                 If Dummy = 'X' then exit;
  593.                 If Dummy = 'M' then
  594.                   If (Planet_Code> '0') And (Planet_Code < '6') then special_Maps
  595.                     else map_dump;
  596.                 end;
  597.           End;
  598.        End;
  599.    If Astral <> 0 then Beep_Wait;
  600.    Menu_Status := 0;
  601.    Randomize;
  602.    If (Statistics_Status <> 3) And (Astral = 0) then Textmode(C80);
  603. End;
  604.  
  605. Procedure Orrory(Bypass : Integer);
  606. Begin;
  607.   Astral := 1;
  608.   Days_Since := (Year - 1970) * 365.25; {count days since 1970 - ignores current leap years}
  609.   If Month >1 then for n := 1 to Month-1 do Days_Since := Days_Since + Days_In_Month[n];
  610.   Days_Since := Days_Since + Day;
  611.   Planet_Details(Bypass);
  612.   Astral := 0;
  613. End;
  614.  
  615. Procedure Grand_Tour; {zoom view of all planets in sector}
  616. Begin;
  617.     For Y_Coordinate := 0 to 9 Do
  618.       For X_Coordinate := 0 to 9 Do
  619.         If demonstration = 1 then Begin;
  620.           WG_System := System_Details [Y_Coordinate, X_Coordinate];
  621.           if WG_System > '!' then begin;
  622.              Astral := 1;
  623.              Orrory(1);
  624.              Astral := 0;
  625.              If demonstration = 1 then planet_details(1);
  626.           end;
  627.         end;
  628. end;
  629.  
  630.  
  631. {-------------------------------------------------------------------------}
  632. {                  EDITING ROUTINES & STATISTICS                          }
  633. {-------------------------------------------------------------------------}
  634.  
  635. {$I WG4.INC}
  636.  
  637. {-------------------------------------------------------------------------}
  638. {                    TITLES, INSTRUCTIONS, ETC.                           }
  639. {-------------------------------------------------------------------------}
  640.  
  641. {$I WG3.INC} {Load in this stuff}
  642.  
  643. {-------------------------------------------------------------------------}
  644. {            THE MAIN PROGRAM!!!!!  & SPECIAL OPTIONS                     }
  645. {-------------------------------------------------------------------------}
  646.  
  647. Procedure Special_Options;
  648. {here there be strange lumpy bits of code that don't fit in very well
  649. anywhere else}
  650. Begin;
  651.    Repeat
  652.    Top_Of_Menu_Screens;
  653.    Writeln('Special Program options'#10#13);
  654.    Write('[B] BEEP on or off'#10#13'[T] Change beep TONE, currently : ',beep_pitch,#10#13'[C] Change COLOUR palette to ');
  655.    Case Screen_Selection of
  656.     0 : Writeln ('Mono 2 [Red / White / Blue, not all CGA cards]');
  657.     1 : Writeln ('Colour [Red / Yellow / Green]');
  658.     2 : Writeln ('Mono 1 [Cyan / Magenta / White]');
  659.    end;
  660.    Writeln('  - mono palettes use special symbols for planets and colonies');
  661.    Write('[M] Choose printer type for MAPS, currently : ');
  662.    Case Map_Choice of
  663.    0: Writeln('Epson graphics'#10#13'  - large slow map');
  664.    1: Writeln('Generic printer'#10#13'  - MUST be capable of 100+ character width, full screen dump N/A!');
  665.    2: Writeln('Tandy CGP-115 Plotter/Printer'#10#13'  - SLOW, press any key to stop, full screen dump N/A!');
  666.    3: Writeln('Epson graphics'#10#13'  - small fast map');
  667.    end;
  668.    Writeln('[P] Set PRINTER page size');
  669.    Writeln('[D] DIRECTORY of all files'#10#13'[U] Directory of USER files');
  670.    Writeln('[S] set SECURITY level, currently : ',Security_Level);
  671.    Writeln(#10#13'[X] Return to main menu'#10#13#10#13'[H] HELP');
  672.    Beep_Wait;
  673.      Case Dummy of
  674.      'B' : If Beep_on = 0 then Beep_on := 1 else Beep_On := 0;
  675.      'M' : Begin;
  676.              Map_Choice := Map_choice + 1;
  677.              If Map_choice = 4 then Map_Choice := 0;
  678.            End;
  679.      'T' : Begin;
  680.             Beep_Pitch := Beep_Pitch * 2;
  681.             If Beep_Pitch >3200 then beep_Pitch := 50;
  682.            end;
  683.      'C' :  Begin;
  684.              Screen_Selection := Screen_Selection + 1;
  685.              If Screen_Selection = 3 then Screen_Selection := 0;
  686.              Colour_Selection;
  687.              Draw_A_Globe;
  688.              Special_Options;
  689.             end;
  690.      'U' : Begin;
  691.              Get_Directory('*.SEC');
  692.              Get_Directory('*.DOC');
  693.              Get_Directory('*.TXT');
  694.              Writeln (Diskfree(0) div 1024,' kbytes free');
  695.              Beep_Wait;
  696.            End;
  697.      'D' : Begin;
  698.              Get_Directory('*.*');
  699.              Writeln(#10#13,Diskfree(0) div 1024,' kbytes free');
  700.              Beep_Wait;
  701.            End;
  702.      'P' : Setup_Printer;
  703.      'S' : Have_A_Nice_Day; {password routine}
  704.      'H' : Help('OPTIONS',' BTCMPDUSX');
  705.      end;
  706.      Until Dummy = 'X';
  707. End;
  708.  
  709. {----------------            Main Program!!           -------------------}
  710.  
  711. Begin;
  712.     Systems_In_Memory := 0;  {set initial variables}
  713.     Beep_On := 1; Beep_Pitch := 400; C_Or_T := 0; Map_Choice := 3; Astral := 0;
  714.     Demonstration := 0; Screen_Selection := 3; Security_Level := 0;
  715.     Bypass_Setup := 0; Bypass_Title := 0;
  716.     If Paramcount > 0 then for I := 1 to Paramcount do begin;
  717.       If (Paramstr(I) = 'S') or (Paramstr(I) = 's') then Beep_on := 0;  {switch sound off}
  718.       If (Paramstr(I) = 'C') or (Paramstr(I) = 'c') then Screen_Selection:= 2;
  719.       If (Paramstr(I) = 'M1') or (Paramstr(I) = 'm1') then Screen_Selection:= 0;
  720.       If (Paramstr(I) = 'M2') or (Paramstr(I) = 'm2') then Screen_Selection:= 1;
  721.       If (Paramstr(I) = 'P') or (Paramstr(I) = 'p') then Bypass_Setup := 1;
  722.       If (Paramstr(I) = 'T') or (Paramstr(I) = 't') then Bypass_Title := 1;
  723.     end;
  724.     Top_Of_Menu_Screens;
  725.     Writeln('DISCLAIMER - This program does not attempt a realistic simulation');
  726.     Writeln('of astronomical processes;  it is simplified,  and heavily biased');
  727.     Writeln('towards the generation of interesting systems for science fiction');
  728.     Writeln('role playing games. It produces a "friendly" universe with plenty');
  729.     Writeln('of places to colonise, explore, and have adventures!'#10#13);
  730.     Writeln('This program requires an IBM PC or Compatible with CGA Graphics');
  731.     Writeln('[Hercules mono cards and text cards are NOT suitable]');
  732.     Writeln;
  733.     If Screen_Selection = 3 then begin;
  734.        Writeln('IF YOU DO NOT HAVE SUITABLE GRAPHICS, PRESS "X" TO EXIT!!!'#10#13'or press any other key to continue');
  735.        Beep_Wait;
  736.        If Dummy = 'X' then exit;
  737.        Writeln (#10#13'Do you have a colour monitor - Press "N" if no, or another'#10#13'key to continue');
  738.        Beep_Wait;
  739.        If Dummy = 'N' then Screen_Selection := 0 else Screen_Selection := 2;
  740.     End;
  741.     Writeln;
  742.     If Bypass_Setup = 0 then begin;
  743.        Writeln('Set-up may be required for your [Epson-compatible] printer:'#10#13'Press "Y" to set up');
  744.        Beep_Wait;
  745.        If Dummy = 'Y' then Setup_Printer;
  746.     end;
  747.     Colour_Selection;
  748.     Statistics_Status := -1;
  749.     If Bypass_Title = 0 then Titles;
  750.     Randomize;
  751.     Repeat
  752.     Repeat
  753.        Top_Of_Menu_Screens;
  754.        Writeln('Press keys for program options'#10#10#13'[G] GENERATE new sector');
  755.        Writeln('[S] SAVE sector         [edited or generated sector]'#10#13'[L] LOAD old sector');
  756.        Writeln(#10#13'[V] VIEW a sector       [loaded or generated sector]');
  757.        Writeln('[Z] ZOOM system details [loaded or generated system]');
  758.        Writeln('[E] EDIT solar system   [loaded or generated system]');
  759.        Writeln('[D] Sector DATA         [loaded or generated sector]');
  760.        Writeln(#10#13'[T] TUTORIAL'#10#13'[R] ROLLING demonstration');
  761.        Writeln(#10#13'[O] Special OPTIONS'#10#13'[Q] QUIT'#10#13#10#13'[I] INFORMATION         [H] HELP');
  762.        If Security_Level > 1 then begin;
  763.          WG_Textcolor(Red);
  764.          Go_Away(1,8); Go_Away(1,13);
  765.          If Security_Level > 2 then Go_Away(1,7);
  766.          If Security_Level > 3 then begin;
  767.            Go_Away(1,12); Go_Away(1,14);
  768.          end;
  769.          WG_Textcolor(lightGreen);
  770.          gotoxy(1,21);
  771.        end;
  772.        Beep_Wait;
  773.        Case Dummy of
  774.          'T': Instructions;   {Display instructions}
  775.          'G': If Security_Level < 3 then Begin;
  776.                 Status := 1;
  777.                 Draw_Grid;    {Randomly generate a sector}
  778.                 Random_Systems;
  779.                 Solar_Systems;
  780.               End;
  781.          'S': If Security_Level < 2 then Save_Data;      {save sector to disk}
  782.          'L': Read_Data;      {load sector from disk}
  783.          'V': Steer_Around_Sector;
  784.          'Z': If Systems_In_Memory = 0 then No_Sector_error
  785.                 else if Security_Level < 4 then begin;
  786.                 Repeat;
  787.                   Help_Used := 0;
  788.                   Top_Of_Menu_Screens;
  789.                   Writeln('Please select option:'#10#13'[Z] ZOOM into one solar system');
  790.                   Writeln('[P] PLANETARIUM view of one solar system'#10#13);
  791.                   Writeln('[G] GRAND tour of sector'#10#13#10'[H] HELP'#10#10#13'Any other key for main menu');
  792.                   Beep_Wait;
  793.                   Case Dummy of
  794.                 'G' : Begin
  795.                         WG_Textcolor(white+blink);
  796.                         Writeln('PRESS ANY KEY TO INTERRUPT TOUR');
  797.                         delay(3000);
  798.                         Demonstration := 1;
  799.                         Grand_Tour;
  800.                         demonstration := 0;
  801.                      end;
  802.                 'Z': Planet_Details(0); {generate planet details}
  803.                 'P': Orrory (0);
  804.                 'H': Begin;
  805.                         HELP('ZOOM',' GZP');
  806.                         Help_Used := 1;
  807.                      End;
  808.                   end;
  809.                 Until Help_Used = 0;
  810.               end;
  811.          'E': If Security_Level < 2 then Magrathea;  {modify systems}
  812.          'D': If Security_Level < 4 then Statistics; {Count the worlds in the sector}
  813.          'O': Special_Options; {go to alternative menu}
  814.          'Q': If Security_Level > 1 then begin;
  815.                Write('Please enter password to end the program :');
  816.                Get_Code_Word;
  817.                If entered_code = Security_Code then Status := 9
  818.                  else writeln('sorry - that is not the correct code');
  819.               end else Status := 9;
  820.          'R': Rolling_Demonstration;
  821.          'H': HELP('MAINMEN',' GSLVZEDTROQI');
  822.          'I': Repeat HELP('INFO',' UASGPFRVB123456789') until Dummy = ' ';
  823.         end;
  824.       Until Status = 9;
  825.       GotoXY(20,20);
  826.       WG_Textcolor(LightRed+Blink);
  827.       Write('Are you SURE you want to quit?');
  828.       WG_Textcolor(Yellow);
  829.       Beep_Wait;
  830.       If Dummy <> 'Y' then begin;
  831.          GotoXY(20,20);
  832.          Writeln('                              ');
  833.          Status := 0;
  834.       End;
  835.    Until Status = 9;
  836.    ClrScr;
  837. End.
  838.